home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-11 / pdrd2.zip / RD.ZIP / RD_DEMO8.PRG < prev    next >
Text File  |  1993-01-11  |  3KB  |  89 lines
  1. /*
  2.     RD_DEMO8.PRG
  3.  
  4.     Demonstration of key validation feature.
  5. */
  6.  
  7. #include "read.ch"
  8.  
  9. //---------
  10. func main()
  11. local getlist[0]
  12. local dDate := date()  
  13. local cIdNum := "A000"
  14. local nT := 4, nL := 10, nB := 7, nR := 26
  15. local cColor := setcolor( if( iscolor(), "W+/BG, GR+/R,,, N/R", nil ) )
  16. local aScn, aScn2
  17. local bConfig := {|e| ADr_keyvalid( e,{|cKey,nPos,nthGet,cBuffer| Xkeyvalid(cKey,nPos,nthGet,cBuffer)} )}
  18.  
  19. cls
  20. aScn = ADbox( nT, nL, nB, nR )
  21. @nT+1, nL+2 say "Date" adget dDate
  22. @nT+2, nL+2 say "ID #" adget cIdNum picture "!999"
  23. aScn2 = ADmessage( { "Every key is validated.  For example, you cannot enter a '3' in",;
  24.                      "the Date's first position.  Neither can you enter anything higher",;
  25.                      "than '2' if the first is a '0'.  As for ID #, you can only enter",;
  26.                      "either an 'A' or a 'B' in the first position, and only digits in",;
  27.                      "the other positions.";
  28.                    }, 16,, .f., .f. )
  29. ADread( getlist, bConfig )
  30. ADrestscn( aScn2 )
  31. ADrestscn( aScn )
  32. setcolor( cColor )
  33. return nil
  34.  
  35.  
  36. //-------------------------------------------
  37. func Xkeyvalid( cKey, nPos, nthGet, cBuffer )
  38. local lValid := .t.
  39.  
  40. if nthGet = 1
  41.     if nPos = 1
  42.         if !cKey $ "01"
  43.             ADmessage( { "Only '0' and '1' are valid in the first position" } )
  44.             lValid = .f.
  45.         endif
  46.     elseif nPos = 2
  47.         if left( cBuffer, 1 ) == "0" .and. cKey == "0"
  48.             ADmessage( { "'0' is not valid in the second position" } )
  49.             lValid = .f.
  50.         elseif left( cBuffer, 1 ) == "1" .and. !cKey $ "012"
  51.             ADmessage( { "Only '0', '1' and '2' are valid in the second position" } )
  52.             lValid = .f.
  53.         endif
  54.     elseif nPos = 4
  55.         if !cKey $ "0123"
  56.             ADmessage( { "Only '0', '1', '2', and '3' are valid in the 4th position" } )
  57.             lValid = .f.
  58.         endif
  59.     elseif nPos = 5
  60.         if substr( cBuffer, 4, 1 ) == "3" .and. !cKey $ "01"
  61.             ADmessage( { "'0' and '1' are valid in the 5th position" } )
  62.             lValid = .f.
  63.         endif
  64.     elseif nPos = 7
  65.         if cKey != "9"
  66.             ADmessage( { "Only '9' is valid in the 7th position" } )
  67.             lValid = .f.
  68.         endif
  69.     elseif nPos = 8
  70.         if !cKey $ "0123"
  71.             ADmessage( { "Only '0', '1', '2', and '3' are valid in the last position" } )
  72.             lValid = .f.
  73.         endif
  74.     endif
  75. elseif nthGet = 2
  76.     if nPos = 1
  77.         if !cKey $ "ABab"
  78.             ADmessage( { "Only 'A' and 'B' are valid in the first position" } )
  79.             lValid = .f.
  80.         endif
  81.     else
  82.         if !cKey $ "0123456789"
  83.             ADmessage( { "Only digits are valid in the 2nd to the last positions" } )
  84.             lValid = .f.
  85.         endif
  86.     endif
  87. endif
  88. return lValid
  89.